home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / GIMP 2.6.8 / gimp-2.6.8-i686-setup.exe / {app} / share / gimp / 2.0 / scripts / mkbrush.scm < prev    next >
Text File  |  2009-12-15  |  9KB  |  263 lines
  1. ; GIMP - The GNU Image Manipulation Program
  2. ; Copyright (C) 1995 Spencer Kimball and Peter Mattis
  3. ;
  4. ; Make-Brush - a script for the script-fu program
  5. ; by Seth Burgess 1997 <sjburges@ou.edu>
  6. ;
  7. ; 18-Dec-2000 fixed to work with the new convention (not inverted) of
  8. ;             gbr saver (jtl@gimp.org)
  9. ;
  10. ; This program is free software; you can redistribute it and/or modify
  11. ; it under the terms of the GNU General Public License as published by
  12. ; the Free Software Foundation; either version 2 of the License, or
  13. ; (at your option) any later version.
  14. ;
  15. ; This program is distributed in the hope that it will be useful,
  16. ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ; GNU General Public License for more details.
  19. ;
  20. ; You should have received a copy of the GNU General Public License
  21. ; along with this program; if not, write to the Free Software
  22. ; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24.  
  25. (define (script-fu-make-brush-rectangular name width height spacing)
  26.   (let* (
  27.         (img (car (gimp-image-new width height GRAY)))
  28.         (drawable (car (gimp-layer-new img
  29.                                        width height GRAY-IMAGE
  30.                                        "MakeBrush" 100 NORMAL-MODE)))
  31.         (filename (string-append gimp-directory
  32.                                  "/brushes/r"
  33.                                  (number->string width)
  34.                                  "x"
  35.                                  (number->string height)
  36.                                  ".gbr"))
  37.         )
  38.  
  39.     (gimp-context-push)
  40.  
  41.     (gimp-image-undo-disable img)
  42.     (gimp-image-add-layer img drawable 0)
  43.  
  44.     (gimp-context-set-background '(255 255 255))
  45.     (gimp-drawable-fill drawable BACKGROUND-FILL)
  46.  
  47.     (gimp-rect-select img 0 0 width height CHANNEL-OP-REPLACE FALSE 0)
  48.  
  49.     (gimp-context-set-background '(0 0 0))
  50.     (gimp-edit-fill drawable BACKGROUND-FILL)
  51.  
  52.     (file-gbr-save 1 img drawable filename "" spacing name)
  53.     (gimp-image-delete img)
  54.  
  55.     (gimp-context-pop)
  56.  
  57.     (gimp-brushes-refresh)
  58.     (gimp-context-set-brush name)
  59.   )
  60. )
  61.  
  62. (script-fu-register "script-fu-make-brush-rectangular"
  63.   _"_Rectangular..."
  64.   _"Create a rectangular brush"
  65.   "Seth Burgess <sjburges@ou.edu>"
  66.   "Seth Burgess"
  67.   "1997"
  68.   ""
  69.   SF-STRING     _"Name"    "Rectangle"
  70.   SF-ADJUSTMENT _"Width"   '(20 1 200 1 10 0 1)
  71.   SF-ADJUSTMENT _"Height"  '(20 1 200 1 10 0 1)
  72.   SF-ADJUSTMENT _"Spacing" '(25 1 100 1 10 1 0)
  73. )
  74.  
  75. (script-fu-menu-register "script-fu-make-brush-rectangular"
  76.                          "<Brushes>")
  77.  
  78.  
  79. (define (script-fu-make-brush-rectangular-feathered name width height
  80.                                                     feathering spacing)
  81.   (let* (
  82.         (widthplus (+ width feathering))
  83.         (heightplus (+ height feathering))
  84.         (img (car (gimp-image-new widthplus heightplus GRAY)))
  85.         (drawable (car (gimp-layer-new img
  86.                                        widthplus heightplus GRAY-IMAGE
  87.                                        "MakeBrush" 100 NORMAL-MODE)))
  88.         (filename (string-append gimp-directory
  89.                                  "/brushes/r"
  90.                                  (number->string width)
  91.                                  "x"
  92.                                  (number->string height)
  93.                                  "f"
  94.                                  (number->string feathering)
  95.                                  ".gbr"))
  96.         )
  97.  
  98.     (gimp-context-push)
  99.  
  100.     (gimp-image-undo-disable img)
  101.     (gimp-image-add-layer img drawable 0)
  102.  
  103.     (gimp-context-set-background '(255 255 255))
  104.     (gimp-drawable-fill drawable BACKGROUND-FILL)
  105.  
  106.     (cond ((< 0 feathering)
  107.      (gimp-rect-select img
  108.            (/ feathering 2) (/ feathering 2)
  109.            width height CHANNEL-OP-REPLACE TRUE feathering))
  110.     ((>= 0 feathering)
  111.      (gimp-rect-select img 0 0 width height CHANNEL-OP-REPLACE FALSE 0)))
  112.  
  113.     (gimp-context-set-background '(0 0 0))
  114.     (gimp-edit-fill drawable BACKGROUND-FILL)
  115.  
  116.     (file-gbr-save 1 img drawable filename "" spacing name)
  117.     (gimp-image-delete img)
  118.  
  119.     (gimp-context-pop)
  120.  
  121.     (gimp-brushes-refresh)
  122.     (gimp-context-set-brush name)
  123.   )
  124. )
  125.  
  126. (script-fu-register "script-fu-make-brush-rectangular-feathered"
  127.   _"Re_ctangular, Feathered..."
  128.   _"Create a rectangular brush with feathered edges"
  129.   "Seth Burgess <sjburges@ou.edu>"
  130.   "Seth Burgess"
  131.   "1997"
  132.   ""
  133.   SF-STRING     _"Name"       "Rectangle"
  134.   SF-ADJUSTMENT _"Width"      '(20 1 200 1 10 0 1)
  135.   SF-ADJUSTMENT _"Height"     '(20 1 200 1 10 0 1)
  136.   SF-ADJUSTMENT _"Feathering" '(4 1 100 1 10 0 1)
  137.   SF-ADJUSTMENT _"Spacing"    '(25 1 100 1 10 1 0)
  138. )
  139.  
  140. (script-fu-menu-register "script-fu-make-brush-rectangular-feathered"
  141.                          "<Brushes>")
  142.  
  143.  
  144. (define (script-fu-make-brush-elliptical name width height spacing)
  145.   (let* (
  146.         (img (car (gimp-image-new width height GRAY)))
  147.         (drawable (car (gimp-layer-new img
  148.                                        width height GRAY-IMAGE
  149.                                        "MakeBrush" 100 NORMAL-MODE)))
  150.         (filename (string-append gimp-directory
  151.                                  "/brushes/e"
  152.                                  (number->string width)
  153.                                  "x"
  154.                                  (number->string height)
  155.                                  ".gbr"))
  156.         )
  157.  
  158.     (gimp-context-push)
  159.  
  160.     (gimp-image-undo-disable img)
  161.     (gimp-image-add-layer img drawable 0)
  162.  
  163.     (gimp-context-set-background '(255 255 255))
  164.     (gimp-drawable-fill drawable BACKGROUND-FILL)
  165.     (gimp-context-set-background '(0 0 0))
  166.     (gimp-ellipse-select img 0 0 width height CHANNEL-OP-REPLACE TRUE FALSE 0)
  167.  
  168.     (gimp-edit-fill drawable BACKGROUND-FILL)
  169.  
  170.     (file-gbr-save 1 img drawable filename "" spacing name)
  171.     (gimp-image-delete img)
  172.  
  173.     (gimp-context-pop)
  174.  
  175.     (gimp-brushes-refresh)
  176.     (gimp-context-set-brush name)
  177.   )
  178. )
  179.  
  180. (script-fu-register "script-fu-make-brush-elliptical"
  181.   _"_Elliptical..."
  182.   _"Create an elliptical brush"
  183.   "Seth Burgess <sjburges@ou.edu>"
  184.   "Seth Burgess"
  185.   "1997"
  186.   ""
  187.   SF-STRING     _"Name"    "Ellipse"
  188.   SF-ADJUSTMENT _"Width"   '(20 1 200 1 10 0 1)
  189.   SF-ADJUSTMENT _"Height"  '(20 1 200 1 10 0 1)
  190.   SF-ADJUSTMENT _"Spacing" '(25 1 100 1 10 1 0)
  191. )
  192.  
  193. (script-fu-menu-register "script-fu-make-brush-elliptical"
  194.                          "<Brushes>")
  195.  
  196.  
  197. (define (script-fu-make-brush-elliptical-feathered name
  198.                                                    width height
  199.                                                    feathering spacing)
  200.   (let* (
  201.         (widthplus (+ feathering width)) ; add 3 for blurring
  202.         (heightplus (+ feathering height))
  203.         (img (car (gimp-image-new widthplus heightplus GRAY)))
  204.         (drawable (car (gimp-layer-new img
  205.                                        widthplus heightplus GRAY-IMAGE
  206.                                        "MakeBrush" 100 NORMAL-MODE)))
  207.         (filename (string-append gimp-directory
  208.                                  "/brushes/e"
  209.                                  (number->string width)
  210.                                  "x"
  211.                                  (number->string height)
  212.                                  "f"
  213.                                  (number->string feathering)
  214.                                  ".gbr"))
  215.         )
  216.  
  217.     (gimp-context-push)
  218.  
  219.     (gimp-image-undo-disable img)
  220.     (gimp-image-add-layer img drawable 0)
  221.  
  222.     (gimp-context-set-background '(255 255 255))
  223.     (gimp-drawable-fill drawable BACKGROUND-FILL)
  224.  
  225.     (cond ((> feathering 0)   ; keep from taking out gimp with stupid entry.
  226.         (gimp-ellipse-select img
  227.            (/ feathering 2) (/ feathering 2)
  228.            width height CHANNEL-OP-REPLACE
  229.            TRUE TRUE feathering))
  230.           ((<= feathering 0)
  231.         (gimp-ellipse-select img 0 0 width height
  232.            CHANNEL-OP-REPLACE TRUE FALSE 0)))
  233.  
  234.     (gimp-context-set-background '(0 0 0))
  235.     (gimp-edit-fill drawable BACKGROUND-FILL)
  236.  
  237.     (file-gbr-save 1 img drawable filename "" spacing name)
  238.     (gimp-image-delete img)
  239.  
  240.     (gimp-context-pop)
  241.  
  242.     (gimp-brushes-refresh)
  243.     (gimp-context-set-brush name)
  244.   )
  245. )
  246.  
  247. (script-fu-register "script-fu-make-brush-elliptical-feathered"
  248.   _"Elli_ptical, Feathered..."
  249.   _"Create an elliptical brush with feathered edges"
  250.   "Seth Burgess <sjburges@ou.edu>"
  251.   "Seth Burgess"
  252.   "1997"
  253.   ""
  254.   SF-STRING     _"Name"       "Ellipse"
  255.   SF-ADJUSTMENT _"Width"      '(20 1 200 1 10 0 1)
  256.   SF-ADJUSTMENT _"Height"     '(20 1 200 1 10 0 1)
  257.   SF-ADJUSTMENT _"Feathering" '(4 1 100 1 10 0 1)
  258.   SF-ADJUSTMENT _"Spacing"    '(25 1 100 1 10 1 0)
  259. )
  260.  
  261. (script-fu-menu-register "script-fu-make-brush-elliptical-feathered"
  262.                          "<Brushes>")
  263.